home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBJ1_2.ZIP;1 / C_ONEDBF.PRG < prev    next >
Encoding:
Text File  |  1993-01-21  |  10.4 KB  |  324 lines
  1. //*****************************************************************************
  2. // C_OneDbf.prg
  3. // OneDbf class for OBJECT v2.03
  4. // Copyright (c) 1991, JHK, JHK-Software, Piestany
  5. // Please compile with: /N/M/W/A
  6. //-----------------------------------------------------------------------------
  7.  
  8. #include "Object.ch"
  9.  
  10.  
  11. create class OneDbf       //help class for Dbf, work around one database
  12.   export:
  13.   var File       // ""    //full path file name
  14.   var Name       // ""    //alias = file name
  15.   var Struc      // {}    //{{cName,cType,nLen,nDec},...}
  16.   var Pict       // {}    //{cPicture,...}
  17.   var PreBlock   // {}    //{bWhen,...}
  18.   var PostBlock  // {}    //{bValid,...}
  19.   var Ntx        // {}    //{{cName,cFile,cKey,lUnique,lUser},...}
  20.   var Rel        // {}    //{{xKey,cAlias,nOrder},...} relation(s) from this Dbf into another
  21.   method New=OneDbfNew             //o:New()
  22.   method Init=OneDbfInit           //o:Init()
  23.   method Create=OneDbfCreate       //o:Create(lContinue)             //create the database and its indexes
  24.   method Open=OneDbfOpen           //o:Open(lShared,lContinue,lNew)  //open ...
  25.   method NtxOpen=OneDbfNtxOpen     //o:NtxOpen(lContinue)            //open indexes (database must be opened)
  26.   method ReIndex=OneDbfReIndex     //o:ReIndex(lContinue)            //recreate exist indexes
  27.   method Pack=OneDbfPack           //o:Pack(lContinue)
  28.   method Zap=OneDbfZap             //o:Zap(lContinue)
  29.   method SetRelation=OneDbfSetRelation      //o:SetRelation()                    //all need databases must be opened
  30.   method AddField=OneDbfAddField            //o:AddField(cName,cType,nLen,nDec)
  31.   method AddNtx=OneDbfAddNtx                //o:AddNtx(cName,cFile,cKey,lUnique,lUser) //cName & lUser are for View-Index-Menu
  32.   method AddRelation=OneDbfAddRelation      //o:AddRelation(xKey,cAlias,nOrder)        //xKey from current dbf into cAlias with nOrder
  33.   method Picture=OneDbfPicture              //o:Picture(cPict)
  34.   method Range=OneDbfRange                  //o:Range(nLo,nHi)
  35.   method When=OneDbfWhen                    //o:When(bWhen)
  36.   method Valid=OneDbfValid                  //o:Valid(bValid)    //standart validation
  37.   method ChValid=OneDbfChValid              //o:ChValid(bValid)    //eval bValid only if Get:Changed==true
  38.   endclass
  39.  
  40.  
  41. //*****************************************************************************
  42. // OneDbf:New() --> self
  43. // initialize new object
  44. //
  45. constructor OneDbfNew()
  46.   ::File:= ""
  47.   ::Name:= ""
  48.   ::Struc:= {}
  49.   ::Pict:= {}
  50.   ::PreBlock:= {}
  51.   ::PostBlock:= {}
  52.   ::Ntx:= {}
  53.   ::Rel:= {}
  54.   return(self)
  55.  
  56.  
  57. //*****************************************************************************
  58. // OneDbf:Init() --> true
  59. // dummy initialize (new) object from OneDbf class.
  60. //
  61. method function OneDbfInit()
  62.   return(true)
  63.  
  64.  
  65. //*****************************************************************************
  66. // OneDbf:Create(lContinue) --> true/false
  67. // create and Open one database and her associated indexes.
  68. //
  69. method function OneDbfCreate(lContinue)
  70.   local i
  71.   default lContinue to true
  72.   SaveDOut(ResTxt(157)+::File+" ...")
  73.   select 0
  74.   NetDbCreate(::File,::Struc,lContinue)
  75.     if NetErr(); RestDOut(); return(false); endif
  76.   NetdbUseArea(true,,::File,::Name,true,false,lContinue)  //new,rdd,db,alias,share,read_only,lContinue
  77.     if NetErr(); RestDOut(); return(false); endif
  78.   ::ReIndex(lContinue)
  79.   RestDOut()
  80.   return(true)
  81.  
  82.  
  83. //*****************************************************************************
  84. // OneDbf:Open(lShared,lContinue,lNew) --> true/false
  85. // open one database and her associated indexes
  86. // *.dbf must be exist, *.ntx may be created
  87. //
  88. method function OneDbfOpen(lShared,lContinue,lNew)
  89.   local i
  90.   local cIndexes:=""
  91.   default lShared to true
  92.   default lContinue to true
  93.   default lNew to true
  94.   SaveDOut(ResTxt(159)+::File+if(!lShared," exclusive","")+" ...")
  95.   if !File(::File)
  96.     Abort("File "+::File+" not found!")
  97.   endif
  98.   NetDbUseArea(lNew,,::File,::Name,lShared,false,lContinue) //new,rdd,db,alias,share,read_only,lContinue
  99.   if NetErr()
  100.     RestDOut()
  101.     return(false)
  102.   endif
  103.   ::NtxOpen(lContinue)
  104.   RestDOut()
  105.   return(!NetErr())
  106.  
  107.  
  108. //*****************************************************************************
  109. // OneDbf:NtxOpen(lContinue) --> true/false
  110. // open the indexes
  111. //
  112. method function OneDbfNtxOpen(lContinue)
  113.   local c:=""
  114.   select (::Name)
  115.  
  116.   DbClearIndex()
  117.   AEval(::Ntx,{|e|if(!File(e[2]+".ntx"),CreateIndex(e,lContinue),nil)})
  118.   AEval(::Ntx,{|e|c+=","+e[2]})
  119.   NetSetIndex(SubStr(c,2),lContinue)
  120.   set order to 0
  121.   return(!NetErr())
  122.  
  123.  
  124. //*****************************************************************************
  125. // OneDbf:ReIndex(lContinue) --> true/false
  126. // recreate indexes
  127. //
  128. method function OneDbfReIndex(lContinue)
  129.   local Ok,s,o
  130.   s:=Select()
  131.   select (::Name)
  132.   o:=IndexOrd()
  133.   DbClearIndex()
  134.   AEval(::Rel,{|e|UpDateRelations(e)})
  135.   AEval(::Ntx,{|e|CreateIndex(e,lContinue)})
  136.   if NetErr(); return(false); endif
  137.   Ok:=::NtxOpen(lContinue)
  138.   set order to (o)
  139.   select (s)
  140.   return(Ok)
  141.  
  142. //-----------------------------------------------------------------------------
  143. static function UpDateRelations(e)
  144.   local s:=Select()
  145.   select (e[2])
  146.   set order to (e[3])
  147.   select (s)
  148.   return(true)
  149.  
  150. //-----------------------------------------------------------------------------
  151. function CreateIndex(e,lContinue)  //e=={cName,cFile,cKey,lUnique}
  152.   SaveDOut(ResTxt(157)+e[2]+".ntx ...")
  153.   NetIndexOn(e[2],e[3],&("{||"+e[3]+"}"),e[4],lContinue)
  154.   DbClearIndex()
  155.   RestDOut()
  156.   return(!NetErr())
  157.  
  158.  
  159. //*****************************************************************************
  160. // OneDbf:SetRelation() --> true
  161. // build the relation scheme for current selected database (alias)
  162. //
  163. method function OneDbfSetRelation()
  164.   local i,r
  165.   select (::Name)
  166.   DbClearRel()
  167.   for i:=1 to Len(::Rel)
  168.     r:=::Rel[i]
  169.     DbSetRelation( r[2], &("{||"+r[1]+"}"), r[1] )
  170.   endfor
  171.   return(true)
  172.  
  173.  
  174. //*****************************************************************************
  175. // OneDbf:Pack(lContinue) --> nil
  176. // pack database.
  177. //
  178. method function OneDbfPack(lContinue)
  179.   local s,o
  180.   default lContinue to false
  181.   s:=Select()
  182.   select (::Name)
  183.   if LastRec()>0
  184.     o:=IndexOrd()
  185.     ::Open(false,lContinue,false)  //lshared,lcontinue,lnew
  186.     if !NetErr()
  187.       SaveDOut(ResTxt(160)+::File+" ...")
  188.       pack  //do not use the "net pack" (unterminated recursion loop)
  189.       commit
  190.       RestDOut()
  191.     endif
  192.     ::Open(,false,false)
  193.     ::SetRelation()
  194.     set order to (o)
  195.   endif
  196.   select (s)
  197.   return(true)
  198.  
  199.  
  200. //*****************************************************************************
  201. // OneDbf:Zap(lContinue) --> true/false
  202. // zap database.
  203. //
  204. method function OneDbfZap(lContinue)
  205.   local s,o
  206.   default lContinue to false
  207.   s:=Select()
  208.   select (::Name)
  209.   o:=IndexOrd()
  210.   ::Open(false,lContinue,false)  //shared,continue,new
  211.   if !NetErr()
  212.     SaveDOut(ResTxt(161)+::File+" ...")
  213.     zap  //do not use the "net zap" (unterminated recursion loop)
  214.     commit
  215.     RestDOut()
  216.   endif
  217.   ::Open(,false,false)
  218.   ::SetRelation()
  219.   set order to (o)
  220.   select (s)
  221.   return(true)
  222.  
  223.  
  224. //*****************************************************************************
  225. // OneDbf:AddField(cName,cType,nLen,nDec) --> true
  226. // add new field info into object.
  227. //
  228. method function OneDbfAddField(cName,cType,nLen,nDec)
  229.   cName:=Upper(cName)
  230.   cType:=Upper(cType)
  231.   do case
  232.     case cType=="C"; default nLen to 10, nDec to 0
  233.     case cType=="N"; default nLen to 10, nDec to 0
  234.     case cType=="D"; default nLen to  8, nDec to 0
  235.     case cType=="M"; default nLen to 10, nDec to 0
  236.     case cType=="L"; default nLen to  1, nDec to 0
  237.   endcase
  238.   AAdd(::Struc,{cName,cType,nLen,nDec})
  239.   AAdd(::Pict,nil)
  240.   AAdd(::PreBlock,nil)
  241.   AAdd(::PostBlock,nil)
  242.   HelpAssoc(::Name+"->"+cName,cName,HelpReserved(,+1))
  243.   return(true)
  244.  
  245.  
  246. //*****************************************************************************
  247. // OneDbf:AddNtx(cName,cFile,cKey,lUnique,lUser) --> true
  248. // add new index info into object.
  249. //
  250. method function OneDbfAddNtx(cName,cFile,cKey,lUnique,lUser)
  251.   default cName to "~"+NTrim(Len(::Ntx)+1)+"."+GetAlias(cFile)+" "
  252.   default lUnique to false
  253.   default lUser to false
  254.   if At("'",cKey)==0 and At('"',cKey)==0; cKey:=Upper(cKey); endif
  255.   AAdd(::Ntx,{cName,Upper(cFile),cKey,lUnique,lUser})
  256.   return(true)
  257.  
  258.  
  259. //*****************************************************************************
  260. // OneDbf:AddRelation(xKey,cAlias,nOrder) --> true
  261. // add new relation into object.
  262. //
  263. method function OneDbfAddRelation(xKey,cAlias,nOrder)
  264.   if ValType(xKey)=="C"
  265.     if At("'",xKey)==0 and At('"',xKey)==0
  266.       xKey:=Upper(xKey)
  267.       if SubStr(xKey,1,7)=="FIELD->"
  268.         xKey:=::Name+SubStr(xKey,6)
  269.       endif
  270.     endif
  271.   endif
  272.   AAdd(::Rel,{xKey,Upper(cAlias),nOrder})
  273.   return(true)
  274.  
  275.  
  276. //*****************************************************************************
  277. // OneDbf:Picture(cPict) --> true
  278. // save picture code for last field into object.
  279. //
  280. method function OneDbfPicture(cPict)
  281.   ::Pict[Len(::Pict)]:=cPict
  282.   return(true)
  283.  
  284.  
  285. //*****************************************************************************
  286. // OneDbf:Range(nLo,nHi) --> true
  287. // save range information for last field into object.
  288. //
  289. method function OneDbfRange(nLo,nHi)
  290.   ::PostBlock[Len(::PostBlock)]:={|_1|if(RangeCheck(_1,,nLo,nHi),true,(Alert(ResTxt(099),ResTxt(099)),false))}
  291.   return(true)
  292.  
  293.  
  294. //*****************************************************************************
  295. // OneDbf:When(bWhen) --> true
  296. // save when code block for last field into object.
  297. //
  298. method function OneDbfWhen(bWhen)
  299.   ::PreBlock[Len(::PreBlock)]:=bWhen
  300.   return(true)
  301.  
  302.  
  303. //*****************************************************************************
  304. // OneDbf:Valid(bValid) --> true
  305. // save valid code block for last field into object.
  306. // standart validation
  307. //
  308. method function OneDbfValid(bValid)
  309.   ::PostBlock[Len(::PostBlock)]:=bValid
  310.   return(true)
  311.  
  312.  
  313. //*****************************************************************************
  314. // OneDbf:ChValid(bValid) --> true
  315. // save valid code block for last field into object.
  316. // eval bValid only if Get:Changed==true
  317. //
  318. method function OneDbfChValid(bValid)
  319.   ::PostBlock[Len(::PostBlock)]:={|G,l,v|if(G:Changed,Eval(bValid,G,l,v),true)}
  320.   return(true)
  321.  
  322. //------------------------------------------------------- eof (c)JHK ----------
  323.  
  324.